home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr36
/
lod370e.zip
/
PROGRAMR.ZIP
/
EMSALLOC.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-12-12
|
13KB
|
467 lines
unit emsalloc;
{ EMS Memory interface unit. This unit is used to allow for transparent }
{ usage of EMS for certain variables using the EAADDR and EAALLOC functions. }
{ Make sure to call EAINIT with the proper parameters (I use }
{ EAINIT(4,20,true) myself) before using EAADDR or EAALLOC. }
{ }
{ Note: Some of the lower level code came from one of Borland's Turbo Pascal }
{ example programs. }
{ }
{ Scott M. Baker, August 1992 }
interface
uses dos;
function emm_installed: boolean;
Function EMS_Pages_Available(Var Total_EMS_Pages,Pages_Available: Word): Word;
Function Allocate_Expanded_Memory_Pages(Pages_Needed: Word; Var Handle: Word): Word;
Function Map_Expanded_Memory_Pages(Handle,Logical_Page,Physical_Page: Word): Word;
Function Get_Page_Frame_Base_Address(Var Page_Frame_Address: Word): Word;
Function Deallocate_Expanded_Memory_Pages(Handle: Word): Word;
Function Get_Version_Number(Var Version_String: string): Word;
type
{$IFDEF DPMI}
EAPointer=pointer;
EAAddr=pointer;
{$ELSE}
EAPointer=array[1..3] of byte;
{$ENDIF}
const
EAemsavail: boolean = false;
var
EAemshandle: word;
EAexitsave: pointer;
EAemstotal: word;
EAemsused: word;
EAphypagemap: array[0..3] of word;
EAPageLocked: array[0..3] of word;
EApageaddr: array[0..255] of word;
EAphyacc: array[0..3] of longint;
EAphyacccount: longint;
EAframebase: longint;
EAconvmemused: longint;
EAemsmemused: longint;
procedure EAinit(minpage,maxpage: word; tryems: boolean);
procedure EAAlloc(var p: EApointer; size: word);
{$IFNDEF DPMI}
function EAAddr(var p: eapointer): pointer;
{$ENDIF}
function EAEmsLeft: longint;
procedure EABlockRead(var FilVar: file; Dest: EAPointer; numbytes: word);
procedure EABlockWrite(var FilVar: file; Dest: EAPointer; numbytes: word);
procedure EAlockvar(p: eapointer);
procedure EAunlockvar(p: eapointer);
function EAisnil(p: eapointer): boolean;
Const
EMM_INT = $67;
DOS_Int = $21;
GET_PAGE_FRAME = $41;
GET_UNALLOCATED_PAGE_COUNT= $42;
ALLOCATE_PAGES = $43;
MAP_PAGES = $44;
DEALLOCATE_PAGES = $45;
GET_VERSION = $46;
STATUS_OK = 0;
implementation
{---------------------------------------------------------}
{ The function Emm_Installed checks to see if the Expanded
Memory Manager (EMM) is loaded in memory. It does this by
looking for the string 'EMMXXXX0', which should be located
at 10 bytes from the beginning of the code segment pointed
to by the EMM interrupt, 67h }
Function Emm_Installed: Boolean;
Var
Emm_Device_Name : string[8];
Int_67_Device_Name : string[8];
Position : Word;
Regs : registers;
Begin
Int_67_Device_Name:='';
Emm_Device_Name :='EMMXXXX0';
with Regs do Begin
{ Get the code segment pointed to by Interrupt 67h, the EMM
interrupt by using DOS call $35, 'get interrupt vector' }
AH:=$35;
AL:=EMM_INT;
Intr(DOS_int,Regs);
{ The ES pseudo-register contains the segment address pointed
to by Interrupt 67h }
{ Create an 8 character string from the 8 successive bytes
pointed to by ES:$0A (10 bytes from ES) }
For Position:=0 to 7 do Int_67_Device_Name:=Int_67_Device_Name+Chr(mem[ES:Position+$0A]);
Emm_Installed:=True;
{ Is it the EMM manager signature, 'EMMXXXX0'? then EMM is
installed and ready for use, if not, then the EMM manager
is not present }
If Int_67_Device_Name<>Emm_Device_Name then Emm_Installed:=False;
end;
end;
{---------------------------------------------------------}
{ This function returns the total number of EMS pages present
in the system, and the number of EMS pages that are
available for our use }
Function EMS_Pages_Available(Var Total_EMS_Pages,Pages_Available: Word): Word;
Var
Regs: Registers;
Begin
with Regs do Begin
AH:=Get_Unallocated_Page_Count;
intr(EMM_INT,Regs);
Pages_Available:=BX;
Total_EMS_Pages:=DX;
EMS_Pages_Available:=AH
end;
end;
{---------------------------------------------------------}
{ This function requests the desired number of pages from the
EMM }
Function Allocate_Expanded_Memory_Pages(Pages_Needed: Word; Var Handle: Word): Word;
Var
Regs: Registers;
Begin
with Regs do Begin
AH:= Allocate_Pages; { Put the desired number of pages in BX}
BX:=Pages_Needed;
intr(EMM_INT,Regs);
handle:=dx; { EMS handle returned in DX }
Allocate_Expanded_Memory_Pages:=AH; { Error code in AH }
end;
end;
{---------------------------------------------------------}
{ This function maps a logical page onto one of the physical
pages made available to us by the
Allocate_Expanded_Memory_Pages function }
Function Map_Expanded_Memory_Pages(Handle,Logical_Page,Physical_Page: Word): Word;
Var
Regs: Registers;
Begin
with Regs do Begin
AH:=Map_Pages;
AL:=Physical_Page;
BX:=Logical_Page;
DX:=Handle;
Intr(EMM_INT,Regs);
Map_Expanded_Memory_Pages:=AH;
end;
end;
{---------------------------------------------------------}
{ This function gets the physical address of the EMS page
frame we are using. The address returned is the segment
of the page frame. }
Function Get_Page_Frame_Base_Address(Var Page_Frame_Address: Word): Word;
Var
Regs: Registers;
Begin
with Regs do Begin
AH:=Get_Page_Frame;
intr(EMM_INT,Regs);
Page_Frame_Address:=BX;
Get_Page_Frame_Base_Address:=AH;
end;
end;
{---------------------------------------------------------}
{ This function releases the EMS memory pages allocated to
us, back to the EMS memory pool. }
Function Deallocate_Expanded_Memory_Pages(Handle: Word): Word;
Var
Regs: Registers;
Begin
with Regs do Begin
AH:=DEALLOCATE_PAGES;
DX:=Handle;
Intr(EMM_INT,Regs);
Deallocate_Expanded_Memory_Pages:=AH;
end;
end;
{---------------------------------------------------------}
{ This function returns the version number of the EMM as
a 3 character string. }
Function Get_Version_Number(Var Version_String: string): Word;
Var
Regs: Registers;
Word_Part,Fractional_Part: Char;
Begin
with Regs do Begin
AH:=GET_VERSION;
Intr(EMM_INT,Regs);
If AH=STATUS_OK then Begin
Word_Part := Char( AL shr 4 + 48);
Fractional_Part:= Char( AL and $F +48);
Version_String:= Word_Part+'.'+Fractional_Part;
end;
Get_Version_Number:=AH;
end;
end;
{$IFDEF DPMI}
procedure EAinit(minpage,maxpage: word; tryems: boolean);
begin;
eaemsavail:=false;
eaemsused:=0;
eaconvmemused:=0;
eaemsmemused:=0;
end;
procedure EAAlloc(var p: EApointer; size: word);
begin;
getmem(p,size);
end;
{function EAAddr(var p: eapointer): pointer;
begin;
EaAddr:=p;
end;}
procedure EAlockvar(p: eapointer);
begin;
end;
procedure EAunlockvar(p: eapointer);
begin;
end;
function EAisnil(p: eapointer): boolean;
begin;
eaisnil:=(p=nil);
end;
function EAEmsLeft: longint;
begin;
EAEmsleft:=memavail;
end;
procedure EABlockRead(var FilVar: file; Dest: EAPointer; numbytes: word);
begin;
if filerec(filvar).recsize<>1 then halt;
blockread(filvar,dest^,numbytes);
end;
procedure EABlockWrite(var FilVar: file; Dest: EAPointer; numbytes: word);
var
temp: pointer;
begin;
if filerec(filvar).recsize<>1 then halt;
blockwrite(filvar,dest^,numbytes);
end;
{$ELSE}
procedure EAException(b: byte);
var
a: byte;
c: word;
begin;
runerror(255-b);
{1 size > 16384}
{2 no mem}
{3 internal error}
end;
procedure ckerror(i: integer);
begin;
if i<>0 then eaexception(3);
end;
procedure EAcloseup; far;
begin;
if EAemsavail then ckerror(deallocate_expanded_memory_pages(EAemshandle));
exitproc:=EAExitsave;
end;
procedure EAinit(minpage,maxpage: word; tryems: boolean);
var
emsavail: word;
w: word;
begin;
eaemsavail:=false;
eaemsused:=0;
eaconvmemused:=0;
eaemsmemused:=0;
if tryems then begin;
EAEmsAvail:=EMM_Installed;
if EAemsavail=false then exit;
ckerror(ems_pages_available(EAemstotal,emsavail));
if minpage<4 then minpage:=4;
if (emsavail<minpage) then begin;
EAEmsAvail:=false;
exit;
end;
EAemsused:=emsavail;
if EAemsused>255 then EAemsused:=255;
if EAemsused>maxpage then EAemsused:=maxpage;
ckerror(allocate_expanded_memory_pages(EAemsused,EAemshandle));
ckerror(get_page_frame_base_address(w));
EAframebase:=longint(w)*16;
EAphypagemap[0]:=0; ckerror(map_expanded_memory_pages(EAemshandle,0,0));
EAphypagemap[1]:=1; ckerror(map_expanded_memory_pages(EAemshandle,1,1));
EAphypagemap[2]:=2; ckerror(map_expanded_memory_pages(EAemshandle,2,2));
EAphypagemap[3]:=3; ckerror(map_expanded_memory_pages(EAemshandle,3,3));
EAconvmemused:=0;
EAemsmemused:=0;
fillchar(EApageaddr,sizeof(EApageaddr),0);
fillchar(EAphyacc,sizeof(EAphyacc),0);
EAphyacccount:=0;
fillchar(EAPageLocked,sizeof(eapagelocked),0);
end;
EAexitsave:=exitproc;
exitproc:=@EAcloseup;
end;
procedure EAAlloc(var p: EApointer; size: word);
var
p2: pointer;
l: longint;
a,b: integer;
didems: boolean;
begin;
didems:=false;
if EAemsavail then begin;
if size>16384 then EAexception(1);
b:=256;
for a:=0 to EAemsused-1 do if (longint(EApageaddr[a])+longint(size)<16380) and (b=256) then b:=a;
if b<>256 then begin;
p[1]:=(b or 128);
p[2]:=hi(EApageaddr[b]);
p[3]:=lo(EApageaddr[b]);
EApageaddr[b]:=EApageaddr[b]+size;
EAemsmemused:=EAemsmemused+size;
didems:=true;
end;
end;
if not didems then begin;
if memavail<size then EAexception(2);
getmem(p2,size);
l:=(longint(seg(p2^))*16) or ofs(p2^);
p[1]:=l div 65536;
p[2]:=(l mod 65536) div 256;
p[3]:=l mod 256;
EAconvmemused:=EAconvmemused+size;
end;
end;
function EAAddr(var p: eapointer): pointer;
var
l: longint;
p2: pointer;
a,b: integer;
lowest: longint;
pagenum: byte;
begin;
if (p[1] and 128)<>0 then begin;
pagenum:=p[1] and 127;
if eaphypagemap[0]=pagenum then b:=0 else
if eaphypagemap[1]=pagenum then b:=1 else
if eaphypagemap[2]=pagenum then b:=2 else
if eaphypagemap[3]=pagenum then b:=3 else
b:=256;
if b=256 then begin;
lowest:=maxlongint;
b:=256;
for a:=0 to 3 do if (EAphyacc[a]<lowest) and (EAPageLocked[a]=0) then begin;
lowest:=EAphyacc[a];
b:=a;
end;
if b=256 then halt;
ckerror(map_expanded_memory_pages(EAemshandle,p[1] and 127,b));
EAphypagemap[b]:=pagenum;
end;
inc(EAphyacccount);
EAphyacc[b]:=EAphyacccount;
l:=longint(p[2])*256+longint(p[3]);
l:=l+longint(EAframebase);
l:=l+longint(longint(16384)*longint(b));
p2:=ptr(l div 16,l mod 16);
end else begin;
l:=(longint(p[1])*65536)+(longint(p[2])*256)+(longint(p[3]));
p2:=ptr(l div 16,l mod 16);
end;
EAaddr:=p2;
end;
procedure EAlockvar(p: eapointer);
var
pagenum: byte;
begin;
if (p[1] and 128)<>0 then begin;
pagenum:=p[1] and 127;
inc(EApagelocked[pagenum]);
end;
end;
procedure EAunlockvar(p: eapointer);
var
pagenum: byte;
begin;
if (p[1] and 128)<>0 then begin;
pagenum:=p[1] and 127;
if eapagelocked[pagenum]>0 then dec(EApagelocked[pagenum]);
end;
end;
function EAisnil(p: eapointer): boolean;
begin;
eaisnil:=((p[1]=0) and (p[2]=0) and (p[3]=0));
end;
function EAEmsLeft: longint;
begin;
EAEmsleft:=(longint(EAemsused)*16384)-EAemsmemused;
end;
procedure EABlockRead(var FilVar: file; Dest: EAPointer; numbytes: word);
var
temp: pointer;
begin;
if filerec(filvar).recsize<>1 then halt;
getmem(temp,numbytes);
blockread(filvar,temp^,numbytes);
move(temp^,EAAddr(dest)^,numbytes);
freemem(temp,numbytes);
end;
procedure EABlockWrite(var FilVar: file; Dest: EAPointer; numbytes: word);
var
temp: pointer;
begin;
if filerec(filvar).recsize<>1 then halt;
getmem(temp,numbytes);
move(EAAddr(dest)^,temp^,numbytes);
blockwrite(filvar,temp^,numbytes);
freemem(temp,numbytes);
end;
{$ENDIF}
end.